home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / quikcmd3.zip / BLOCKS.LSP < prev    next >
Lisp/Scheme  |  1992-07-05  |  6KB  |  163 lines
  1. ;  BLOCKS.LSP
  2.  ;
  3.  ;                         QUICK COMMAND Release 3.0
  4.  ;                   BLOCKS.LSP is a module of QUICK COMMAND
  5. ;                        Copyright 1989, 90, 92 Dan Jincks
  6.  ;
  7.  ;
  8. ;              This is SHAREWARE, it is NOT Public Domain software.
  9.  ;
  10.  ;              This code or any part of this code may not be reproduced
  11.  ;              in any publication without prior written permission.
  12.  ;
  13.  ;              Printed copy of this code or any part of this code may not
  14.  ;              be distributed without prior written permission.
  15.  ;
  16.  ;              Printed copy may only be made for reference purposes by
  17.  ;              the end user.
  18.  ;
  19.  ;
  20.  ;                               Dan Jincks
  21.  ;                             Box 155A HCR 77
  22.  ;                           Annapolis, MO 63620
  23.  ;
  24.  ;
  25.  ;
  26.  ;   You are granted a limited license to use BLOCKS.LSP for a 30 day trial
  27.  ;   period.  If you wish to continue using any or all of QUICK COMMAND after
  28.  ;   the trial period, you must become a registered user.  As a registered
  29.  ;   user, you may use QUICK COMMAND on 1 workstation or terminal.
  30.  ;   Additional registrations must be bought for each additional workstation or
  31.  ;   terminal.  To become a registered user, see QC3.DOC
  32.  ;
  33.  ;
  34.  ;   You may send copies of QUICK COMMAND to friends and associates if you abide
  35.  ;   by the following rules:
  36.  ;
  37.  ;   1. It may only be distributed in the original unmodified form.
  38.  ;   2. All original files must be included.
  39.  ;   3. No addition files may be added.
  40.  ;   4. If other files will be on the same disk, QUICK COMMAND files must be in
  41.  ;      a library format such as ".ARC" called "QUICKCMD", or else be put alone
  42.  ;      in a subdirectory called "QUICKCMD".
  43.  ;   5. You may not sell QUICK COMMAND or any part of it.
  44.  ;   6. You are not allowed to charge more then $5 to cover the cost of copying
  45.  ;      and distribution.
  46.  ;   7. You may not distribute any hard copy of the contents of QUICK COMMAND.
  47.  ;
  48.  ;
  49.  ;   These AutoLISP commands and functions are designed to save you time, and
  50.  ;   saving time means saving money.  The registration fee is very modest
  51.  ;   compared to the savings, and much less expensive then typical third party
  52.  ;   AutoCAD software. Be sure to registar if you continue to use them.
  53.  ;
  54.  ;
  55.  ;                                                               DAN
  56.  ;
  57.  ;
  58.  ;
  59.  ;
  60.  ;        AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
  61.  ;
  62.  ;        ***************************************************************
  63.  ;
  64.  ; Begin BLOCKS.LSP
  65.  ;
  66. ;  BLI function
  67.  ;
  68. (defun C:BLI (/ SCA SCB SCC SCD SCE SCF SCG)(terpri)
  69.    (setvar "cmdecho" 0)
  70.    (prompt "Define a block, then insert back into original place")(terpri)
  71.    (prompt " ")(terpri)
  72.    (setq SCA (strcase (getstring "Block name (or ?):  ")))(terpri)
  73.    (setq SCF (strlen SCA))
  74.    (setq SCD (tblsearch "block" SCA))
  75.    (if (/= SCD nil)(progn
  76.       (setq SCG (ssget "X" (list (cons 2 SCA))))
  77.       (command "select" SCG)
  78.       (prompt "Block  ")(princ SCA)(prompt "  already exists.")(terpri)
  79.       (prompt " ")(terpri)(prompt "Redefine  ")(princ SCA)
  80.       (initget "Yes No")
  81.       (setq SCE (getkword "  ?  Y/N <No>  "))(command "")(terpri)
  82.          (if (/= SCE "Yes")(setq SCA nil))))
  83.    (if (= SCA "?")(progn
  84.       (command "BLOCK" "?" )(setq SCA nil)))
  85.    (if (and (/= SCF 0)(/= SCA nil))(progn
  86.       (setq SCB (getpoint "Insertion base point: "))(terpri)
  87.       (if SCB (setq SCC (ssget)))))
  88.    (if(and SCA SCB SCC)(progn
  89.       (if (/= SCD nil)
  90.          (command "BLOCK" SCA "Yes" SCB SCC "" "INSERT" SCA SCB "" "" "")
  91.          (command "BLOCK" SCA SCB SCC "" "INSERT" SCA SCB "" "" ""))
  92.    ))(setvar "cmdecho" 1)(princ)
  93. )
  94.  ;
  95. ;  WBR function
  96.  ;
  97. (defun C:WBR(/ SCA SCB SCC SCD )(terpri)
  98.    (setvar "cmdecho" 0)
  99.    (prompt "Write to a file, then Restore the drawing.")
  100.    (terpri)
  101.    (setq SCB (strcase (getstring "File name:  ")))(terpri)
  102.    (setq SCC (findfile (strcat SCB ".DWG")))
  103.    (setq SCD (tblsearch "block" SCB))
  104.    (if (= SCD nil)(progn
  105.       (if (= SCC nil)(progn
  106.          (setq SCC (getpoint "Insertion point: "))
  107.          (if SCC (setq SCA (ssget)))
  108.          (if SCA (command "WBLOCK" SCB "" SCC SCA "" "OOPS")))
  109.          (prompt "File already exists - Use WBLOCK command.")
  110.       ))
  111.      (prompt "Block name already used - Use WBLOCK command.")
  112.   )(setvar "cmdecho" 1)(princ)
  113. )
  114.  ;
  115. ;  WBI function
  116.  ;
  117. (defun C:WBI(/ SCA SCB SCC SCD )(terpri)
  118.    (setvar "cmdecho" 0)
  119.    (prompt "Write a Block to a file, then Insert back into original place")
  120.    (terpri)
  121.    (setq SCB (strcase (getstring "File name:  ")))(terpri)
  122.    (setq SCC (findfile (strcat SCB ".DWG")))
  123.    (setq SCD (tblsearch "block" SCB))
  124.    (if (= SCD nil)(progn
  125.       (if (= SCC nil)(progn
  126.          (setq SCC (getpoint "Insertion point: "))
  127.          (if SCC (setq SCA (ssget)))
  128.          (if SCA (command "WBLOCK" SCB "" SCC SCA "" "INSERT" SCB SCC "" "" "")))
  129.          (prompt "File already exists - Use WBLOCK command.")
  130.       ))
  131.      (prompt "Block already exists - Use WBLOCK command.")
  132.   )(setvar "cmdecho" 1)(princ)
  133. )
  134.  ;
  135. ;  BLH function
  136.  ;
  137. (defun C:BLH (/ SCA SCD SCF SCG)
  138.    (setvar "cmdecho" 0)
  139.    (prompt "Highlight all visable occurrences of a Block")(terpri)
  140.    (prompt " ")(terpri)
  141.    (setq SCA (strcase (getstring "Block name:  ")))
  142.    (setq SCF (strlen SCA))
  143.    (setq SCD (tblsearch "block" SCA))(terpri)
  144.    (if (/= SCF 0)(progn
  145.       (if (/= SCD nil)
  146.          (progn
  147.             (graphscr)
  148.             (setq SCG (ssget "X" (list (cons 2 SCA))))
  149.             (if (/= SCG nil)(progn (prompt "Press ENTER")
  150.                   (command "select" SCG pause))
  151.                (prompt "Block is nested or not on screen.")
  152.             )
  153.          )
  154.          (progn (prompt "Block named  ")(princ SCA)(prompt "  is not listed.")
  155.             (prompt "    Press ENTER") (command pause "BLOCK" "?")
  156.          )
  157.       )
  158.    ))
  159.    (setvar "cmdecho" 1)(princ)
  160. )
  161.  ;
  162.  ;   End BLOCKS.LSP
  163.